
# global variable to generate distinct names
glade.counter <- 0
glade.newName <- function(pattern, ext=""){
  glade.counter <<- glade.counter+1;
  return(paste(pattern, glade.counter, ext, sep=""));
}

setClass("glade",
         representation(piggy = "character", # the Piggy program
                        topObj = "character", # the top object this program defines
                        server = "character",
                        user = "character",
                        schema = "data.frame"));

# helper functions

# transform any input (string, parse tree, etc) into string
# WARNING: This function is limited to inputs of size 500L
# thank deparse for the limitation
# deparse produces multiple lines and paste does not like that
glade.normalize <- function(input) {
# the following code is "borrowed" from the definition of bquote
  unquote <- function(e)
     if (length(e) <= 1L) 
       e
     else if (e[[1L]] == as.name(".")) 
       eval(e[[2L]])
     else if (is.pairlist(e)) 
       as.pairlist(lapply(e, unquote))
     else as.call(lapply(e, unquote))
# end borrowing
   input <- unquote(input)
  
  if (is.character(input))
    return(input);

  # formula
  if (class(input) == "formula"){
    if (length(input) == 2){
      return(deparse(input[[2]]), width.cutoff=500L); # expression is ~ bla
    } else {
      return(deparse(input[[3]]), width.cutoff=500L); # expression is x ~ bla, need bla
    }
  }

  # quoted expression
  if (is.call(input) || is.name(input)) {
    return(deparse(input, width.cutoff=500L));
  }

  stop("Argument not recognized", deparse(input));
}

# function to normalize lists
glade.normalize.list <- function(inputs){
  if (length(inputs)<=1L || inputs[[1]] != "|"){ # simple element
    return(c(glade.normalize(inputs)));
  } else {
    return( c( glade.normalize.list(inputs[[2]]),
              glade.normalize(inputs[[3]])) );
  }
}
                        
# generics for GLADE
# access an internal relation
setGeneric("read", function(.Object, relation, alias) standardGeneric("read"));
# like read but for data in external files
# format specifies the type of data. Default is "text"
setGeneric("readFrom", function(.Object, file, format, ...) standardGeneric("readFrom"));

# join two objects
# joinCond expresses the join condition
setGeneric("join", function(.Object1, listAtts1, .Object2, listAtts2) standardGeneric("join"));

# simple aggregate computation, use ??? for a more powerful one
setGeneric("aggregate", function(.Object, aggregate, exp, as) standardGeneric("aggregate"));

# group input on groupAtts, compute aggregate for each group
# return result for each group
# old version (can be deleted?)
#setGeneric("groupby", function(.Object, groupAtts, aggregate, result)
 #          standardGeneric("groupby"));
# new version
setGeneric("groupby", function(.Object, vars, GLA, ...) standardGeneric("groupby"));

# order tuples based on orderAtts, include extraAtts in result
# limit specifies max size of result
setGeneric("orderby", function(.Object, orderAtts, extraAtts, limit)
           standardGeneric("orderby"));


# conversions from R objects to glade
as.glade <- function(.Object, x) {
  if (.Object@topObj != "NA"){
    stop("Relations can be accessed only starting with a fresh GLADE object");
  }

#  print("Class of x: " , class(x));
  if (!is.data.frame(x))
    x <- as.data.frame(x);

  # scan the table and determine the columns and types
  atts <- "";
  for (col in names(x)){
    type <- switch(class(x[,col]),
                   factor = "VARCHAR",
                   numeric = "DOUBLE",
                   character = "VARCHAR",
                   integer = "INT"
                   );
    att <- paste("\t", col, ":", type, sep="");
    if (atts!="")
      atts2 <- paste(atts, att, sep=",\n")
    else
      atts2 <- paste("\n", att, sep="");
    atts <- atts2;
  }
  
  # x is now a data.frame or this failed
  file <- glade.newName("Data_",".csv");
  write.csv(x, file, quote=FALSE, row.names=FALSE); # ,  col.names=FALSE);

  .Object@topObj <- glade.newName("data");
  statement1 <- paste("CREATE TEMP RELATION ", .Object@topObj, "(", atts, "\n);\n"
                      , sep="");
  statement2 <- paste(.Object@topObj, " = READ ", file, " ATTRIBUTES FROM ",
                      .Object@topObj, ";\n"
                      , sep="");
  .Object@piggy <- paste(statement1, statement2, sep="");
  return(.Object);
}

# constructor, server and user assumed set
setMethod("initialize", "glade",
          function(.Object, server, user) {
            # open connection to server
            .Object@server <- server;
            .Object@user <- user;
            .Object@topObj <- "NA"; #invalid
            
            # ask for schema

            .Object@piggy <- ""; # initialize

            return(.Object)
          });

setMethod("show", "glade",
          function(object) {
            cat("Server: ", object@server, "\n");
            cat("User: ", object@user, "\n");
            cat("Program:\n", object@piggy, "\n",sep="");
          });

setMethod("read", "glade",
          function(.Object, relation, alias=relation) {
            if (.Object@topObj != "NA"){
              stop("Relations can be accessed only starting with a fresh GLADE object");
            }
            relation <- glade.normalize(substitute(relation));# glade.normalize(relation);
            .Object@topObj <- relation;
            if (missing(alias)){
              statement <- paste("LOAD ", relation, ";\n",sep="");
            } else {
              alias <- glade.normalize(substitute(alias));
              statement <- paste(alias, " = LOAD ", relation, ";\n",sep="");
              
            }

            #test if relation is a relation
            .Object@piggy <- paste(.Object@piggy, statement, sep="");
            return(.Object)
          });

setMethod("join", "glade",
          function(.Object1, listAtts1, .Object2, listAtts2) {
            if (.Object1@topObj == "NA")
              stop("Left side of join has uninitialized object");

            if (.Object2@topObj == "NA")
              stop("Right side of join has uninitialized object");
            
            topObj <- glade.newName("join");
            statement <- paste(topObj, " = JOIN ",
                               .Object1@topObj, " BY ", glade.normalize(substitute(listAtts1)), ", ",
                               .Object2@topObj, " BY ", glade.normalize(substitute(listAtts2)), ";\n",
                               sep="");
            .Object1@piggy <- paste(.Object1@piggy, .Object2@piggy, statement,sep="");
            .Object1@topObj <- topObj;
            return(.Object1)
          });

setMethod("[", "glade",
          function(x, filter ) { # ugly but forced by [ signature
            if (x@topObj == "NA")
              stop("Argument of filter has uninitialized object");
            ## filter <- substitute(exp);
            ## print("fitler is");
            ## print(deparse(filter));
            
            topObj <- glade.newName("filter");
            statement <- paste(topObj, " = FILTER ",
                               x@topObj, " BY ", glade.normalize(substitute(filter)), ";\n",
                               sep="");
            x@piggy <- paste(x@piggy, statement,sep="");
            x@topObj <- topObj;
            
            
            return(x)
          });

setMethod("aggregate", "glade",
          function(.Object, aggregate, exp, as){
            if (.Object@topObj == "NA")
              stop("Argument of aggregate has uninitialized object");

            aggregate <-glade.normalize(substitute(aggregate));
            exp <- glade.normalize(substitute(exp));
            as <- glade.normalize(substitute(as));
            
            topObj <- glade.newName("agg");
            statement <- paste(topObj, " = AGGREGATE ", aggregate, " FROM ",
                               .Object@topObj, " USING ", exp , " AS ",
                               as, " ;\n",
                               sep="");
            .Object@piggy <- paste(.Object@piggy, statement,sep="");
            .Object@topObj <- topObj;
            
            return(.Object)
          });

     
#group by 
setMethod("groupby", "glade",
          function(.Object, vars, GLA, ...){
           if (.Object@topObj == "NA"){
              stop("Argument of groupby has uninitialized object");
            }
           
           #vars: list of variables to group by separated by |
           #GLA:list of GLAs
           # ... expressions

#sample function call:
#errors when including ":DOUBLE" in result, e.g. year:DOUBLE=fyear
#gby <- groupby(funda, vars=fyear:DOUBLE|SICH:DOUBLE, GLA=SumGLA, year=funda.fyear, SICH=funda.SICH, sum=funda.SALE);
           
            topObj <- glade.newName("gby");
            
            vars <- glade.normalize.list(substitute(vars));
            GLA <- glade.normalize.list(substitute(GLA));
            args <- substitute(list(...));
            lrez <- lapply(args, glade.normalize);

# create a string like the following: 
#gla2 = GLA:GroupByGLA< [year:INT, nat:VARCHAR], GLA:SumGLA> locspd
#    USING date.d_year, customer.c_nation, 
#    	  (lineorder.lo_revenue - lineorder.lo_supplycost)
#    AS year:INT, nation:VARCHAR, profit:DOUBLE;

           printVars <- paste(vars, collapse=", ");
           printGLAs <- paste(paste("GLA:",GLA, sep=""), collapse=", ");
           counter <- 0;
           printUsing <- "USING ";
           printAS <- "AS ";
           for (var in names(lrez)){
              if (var == "") # fluke, some elements are ""
                next; 
              if ( counter== 0){
                printUsing <- paste(printUsing,  lrez[[var]]);
                printAS <- paste(printAS, var);
                counter = counter + 1;
              } else {
                printUsing <-  paste(printUsing,", ", lrez[[var]]);
                printAS <-  paste(printAS, ", ", var);
              }
            }
           
          prevTobObj = .Object@topObj;

           statement <- paste(topObj, " = GLA:GroupByGLA<[", printVars,"], ", printGLAs, "> ", prevTobObj ,sep ="");
          statement <- paste(statement, printUsing,printAS, ";",sep="\n");

          print (statement);

          .Object@piggy <- paste(.Object@piggy, statement,sep="");
          .Object@topObj <- topObj; 
          return(.Object);
          });
                  


#export the result as a data.frame
setMethod("as.data.frame", "glade",
          function(x, ...){
            args <- substitute(list(...));

            lrez <- lapply(args, glade.normalize);
            printBody <- "";
            printAS <- " AS ";
            for (var in names(lrez)){
              if (var == "") # fluke, some elements are ""
                next; 
              if ( printBody != ""){
                printBody <- paste(printBody, ", ", lrez[[var]]);
                printAS <- paste(printAS, ", ", var);
              } else {
                printBody <- args[[var]];
                printAS <- paste(printAS, var, ":bogus");
              }
            }

            fileBase <- tempfile("Q", ".", "");
            pgyFile <- paste(fileBase, ".pgy", sep="");
            rezFile <- paste(fileBase, ".csv", sep="");
            
            printStmt <- paste("PRINT ", x@topObj, " USING ", printBody,
                               printAS, " INTO \"R-RESULT\";\n", sep="");
            x@piggy <- paste(x@piggy, printStmt, sep="");
            # writing the file
            cat(x@piggy, file=pgyFile);
            show(x);

            # no we run
            system(paste("./runPiggy.sh ", pgyFile, rezFile));
            rez <- read.csv(rezFile);
            
            return(rez);
          });
                  
